perm filename TVIOF[PIC,MUS] blob sn#039048 filedate 1973-05-01 generic text, type T, neo UTF8
00100	C	TVIOF			NOVEMBER 9, 69 			                 TVIOF
00200
00300		COMMON /EDGEC/ A0,A1,A2,A3,A4,A5,A6,A7,
00400		1 DEBUG,T,XP,YP,PARMAX,
00500		1 HALF,FILE,RR,COH,RX,RY,CL,SL,D,B,FOUND
00600
00700		COMMON /LISTC/ LIST,LIST5,NEWEND,LO
00800
00900		COMMON/COMMAC/BCLIP,TCLIP,BITS,IWID,LINLEN,FLINE,LLINE,
01000		1 LSIDE,RSIDE,DTA,HYSTAB
01100
01200		DIMENSION LIST5(0/1000),LIST(6,1000),BTLIP(0/15),
01300		1 XP(0/176),YP(0/176),T(0/1415),HYSTAB(0/15)
01400
01500		INTEGER BCLIP,TCLIP,BITS,FLINE,LLINE,
01600		1 LSIDE,RSIDE,HYSTAB,DTA,IB,HEL,I,TIM1,TIM2,TIM4,TIM5,
01700		1 TAPE,FILEN,NEWEND,ALFAB,YES,NO,FILE,BTLIP,LIP
01800
01900		REAL INT,HIG,QAL,QALOLD,NUPO,TIM3,HIL,HILOLD
02000
02100		LOGICAL LOAP,LOAU,PLAY,SAVU,SAVP,NOPR,NOLU,NOLP
02200	CC	LOGICAL FUNCTION ADMISS
02300	CC	ADMISS(DTA)=DTA.EQ.-7.OR.(1.LE.DTA.AND.DTA.LE.10)
02350		TAPE=1
02360		DTA=-7
02400		CALL TIMER(TIM1)
02500	1	CALL INITAL
02600		BCLIP=7
02700		TCLIP=0
02800		BITS=4
02900		FLINE=20
03000		LLINE=250
03100		LSIDE=6
03200		RSIDE=302
03300	C	IWID=RSIDE-LSIDE+1
03400	C	I=36/BITS
03500	C	LINLEN=(IWID+I-1)/I
03600	C	TVSZ=(LLINE-FLINE+1)*LINLEN
03700		YES='Y'
03800		NO ='N'
03900		SAVU=.FALSE.
04000	C	UNPROCESSED PICTURE HAS BEEN SAVED IF SAVU.EQ..TRUE.
04100		SAVP=.FALSE.
04200	C	PROCESSED PICTURE HAS BEEN SAVED
04300		LOAP=.FALSE.
04400	C	PROCESSED PICTURE HAS BEEN LOADED
04500		LOAU=.FALSE.
04600	C	UNPROCESSED PICTURE HAS BEEN LOADED
04700		PLAY=.FALSE.
04800	C	PROGRAMS PICTURE WAS OFFERED OR OVER WRITTEN
04900		NOPR=.FALSE.
05000	C	PROCESSING NOT WANTED
05100		NOLU=.FALSE.
05200	C	LOADING OF UNPROCESSED NOT WANTED
05300		NOLP=.FALSE.
05400	C	LOADING OF PROCESSED NOT WANTED
05500	3	FORMAT(' DO YOU WANT TO TAKE A PICTURE WITH THE TV CAMERA ?'/)
05600		TYPE 3
05700	6	ACCEPT 83,ALFAB
05800		IF(ALFAB.EQ.YES) GOTO 8
05900		IF(ALFAB.EQ.NO ) GOTO 158
06000	C	TYPE 103
06100		GOTO 3
06200	8	DO 9 I=0,15
06300	9	BTLIP(I)=7-I/2
06400	7	FORMAT(' DO YOU WANT TO READ A FRAME
06500		1 OTHER THAN THE MAXIMAL ?'/)
06600	16	TYPE 7
06700		ACCEPT 83, ALFAB
06800		IF(ALFAB.EQ.YES) GOTO 18
06900		IF(ALFAB.EQ.NO ) GOTO 17
07000	CC	TYPE 103
07100		GOTO 16
07200	18	TYPE 19
07300	19	FORMAT(' TYPE  FLINE, LLINE, LSIDE, RSIDE'/)
07400	20	FORMAT(4I)
07500		ACCEPT 20,FLINE,LLINE,LSIDE,RSIDE
07600	21	FORMAT(4I4/)
07700		TYPE 21,FLINE,LLINE,LSIDE,RSIDE
07800	17	CALL TVIN
07900		CALL HISTO
08000		TYPE 63,BCLIP,TCLIP,(HYSTAB(I),I,BTLIP(I),I=0,15)
08100	10	FORMAT(' DO YOU WANT TO OVER WRITE AUTOMATIC CLIP
08200		1 LEVEL SETTING ?'/)
08300	30	TYPE 10
08400	11	ACCEPT 83,ALFAB
08500		IF(ALFAB.EQ.YES) GOTO 13
08600		IF(ALFAB.EQ. NO) GOTO 62
08700	CC	TYPE 103
08800		GOTO 11
08900	12	FORMAT(' TYPE BCLIP'/)
09000	13	TYPE 12
09100		ACCEPT 133,BCLIP
09200	15	FORMAT(1H+,I1/)
09300		TYPE 15,BCLIP
09400	14	FORMAT(' TYPE TCLIP'/)
09500		TYPE 14
09600		ACCEPT 133,TCLIP
09700		TYPE 15, TCLIP
09800		GOTO 67
09900	62	CALL CLIPS
10000	63	FORMAT(7H BCLIP=I2/7H TCLIP=I2//16(I7,2I4/))
10100	66	FORMAT(' RETURN CARRIAGE FOR FINAL TV READING',$)
10200	67	TYPE 66
10300		ACCEPT 83,ALFAB
10400		DO 64 I=0,15
10500		HILOLD=HIL
10600		HIL=(1.0-(FLOAT(I)-0.5)/14.0)*(BCLIP-TCLIP)+TCLIP
10700		BTLIP(I)=-0
10800		IF(I.EQ.0) GOTO 64
10900		LIP=IFIX(HILOLD)
11000		IF(IFIX(HIL).EQ.LIP) GOTO 64
11100		BTLIP(I-1)=LIP
11200		BTLIP(I) = LIP
11300	64	CONTINUE
11400		CALL TVIN
11500		CALL HISTO
11600		TYPE 63,BCLIP,TCLIP,(HYSTAB(I),I,BTLIP(I),I=0,15)
11700	68	FORMAT(' IS THIS ACCEPTABLE ?'/)
11800	69	TYPE 68
11900		ACCEPT 83,ALFAB
12000		IF(ALFAB.EQ.YES) GOTO 71
12100		IF(ALFAB.EQ.NO ) GOTO 30
12200	CC	TYPE 103
12300		GOTO 69
12400	71	LOAU=.TRUE.
12500	75	IF(SAVU) GOTO 152
12600	73	FORMAT(' DO YOU WANT TO SAVE THE UNPROCESSED IMAGE ?'/)
12700		TYPE 73
12800	83	FORMAT(A5)
12900	93	ACCEPT 83,ALFAB
13000		IF(ALFAB.EQ.YES) GOTO 173
13010	CC	IF(ALFAB.EQ.YES) GOTO 123
13100		IF(ALFAB.EQ.NO ) GOTO 151
13200	CC103	FORMAT(33H PLEASE ANSWER ONLY 'YES' OR 'NO'/)
13300	CC	TYPE 103
13400		GOTO 73
13500	CC113	FORMAT(' TYPE NUMBER OF OUTPUT DRIVE'/)
13600	CC123	TYPE 113
13700	133	FORMAT(I)
13800	CC	ACCEPT 133,DTA
13900	CC183	FORMAT(1H+,I2/)
14000	CC	TYPE 183,DTA
14100	CC	IF(ADMISS(DTA)) GOTO 173
14200	CC184	FORMAT(' THIS NUMBER IS NOT PERMISSIBLE'/' FOR DSK TAKE DRIVE -7'/
14300	CC	1' FOR MTA0 TAKE DRIVE 8'/' FOR MTA1 TAKE DRIVE 9'/)
14400	CC	TYPE 184
14500	CC	GOTO 123
14600	193	FORMAT(' GIVE THE FILE A NAME'/)
14700	173	TYPE 193
14800		ACCEPT 83,FILE
14900	CC	TYPE 253,FILE
15000		CALL DECDMP
15100		SAVU=.TRUE.
15200		GOTO 158
15300	151	SAVU=.TRUE.
15400	152	IF(NOPR) GOTO 340
15500	188	FORMAT(' DO YOU WANT TO PROCESS THE IMAGE ?'/)
15600		TYPE 188
15700	198	ACCEPT 83,ALFAB
15800		IF(ALFAB.EQ.YES) GOTO 203
15900		IF(ALFAB.EQ.NO ) GOTO 307
16000	CC	TYPE 103
16100		GOTO 188
16200	158	IF(NOLU) GOTO 308
16300	156	FORMAT(' DO YOU WANT TO LOAD AN UNPROCESSED IMAGE ?'/)
16400		TYPE 156
16500	160	ACCEPT 83,ALFAB
16600		IF(ALFAB.EQ.YES) GOTO 205
16610	CC	IF(ALFAB.EQ.YES) GOTO 165
16700		IF(ALFAB.EQ.NO ) GOTO 304
16800	CC	TYPE 103
16900		GOTO 156
17000	CC164	FORMAT(' TYPE NUMBER OF INPUT DRIVE'/)
17100	CC165	TYPE 164
17200	CC174	ACCEPT 133,DTA
17300	CC	TYPE 183,DTA
17400	CC	IF(ADMISS(DTA)) GOTO 205
17500	CC	TYPE 165
17600	CC	GOTO 174
17700	204	FORMAT(' TYPE THE FILE NAME'/)
17800	205	TYPE 204
17900		ACCEPT 83,FILE
18000	CC	TYPE 253,FILE
18100		CALL DECINP
18200		LOAU=.TRUE.
18300		SAVU=.FALSE.
18400		NOPR=.FALSE.
18500		GOTO 75
18600	203	CALL SCAHEX
18700		SAVP=.FALSE.
18800		NOLU=.FALSE.
18900		PLAY=.TRUE.
19000	202	FORMAT(' NEWEND=',I4/)
19100		TYPE 202,NEWEND
19200	199	LOAP=.TRUE.
19300	209	CONTINUE
19400	210	IF(.NOT.LOAP) GOTO 1
19500	218	CONTINUE
19600	219	IF(SAVP) GOTO 235
19700		IF(.NOT.LOAP) GOTO 1
19800	213	FORMAT(' DO YOU WANT TO SAVE THE PROCESSED IMAGE ?'/)
19900		TYPE 213
20000	223	ACCEPT 83,ALFAB
20100		IF(ALFAB.EQ.YES) GOTO 243
20200		IF(ALFAB.EQ.NO ) GOTO 235
20300	CC	TYPE 103
20400		GOTO 213
20500	CC233	TYPE 113
20600	CC	ACCEPT 133,DTA
20700	CC	TYPE 183,DTA
20800	CC	IF(ADMISS(DTA)) GOTO 243
20900	CC	TYPE 184
21000	CC	GOTO 233
21100	243	TYPE 193
21200		ACCEPT 83,FILE
21300	253	FORMAT(1H+,A5/)
21400	CC	TYPE 253,FILE
21500	CC	TAPE=8+DTA
21600		FILEN=6*(NEWEND+1)
21700		CALL ZERPP
21800		CALL OFILE(TAPE,FILE)
21900		WRITE(TAPE) FILEN,RR,FLINE,LLINE,LSIDE,RSIDE,NEWEND,
22000		1 ((LIST(I,N),I=1,6),N=1,NEWEND)
22100		END FILE TAPE
22200		SAVP=.TRUE.
22300		NOLP=.FALSE.
22400		IF(LOAU) GOTO 75
22500	235	IF(.NOT.LOAP) GOTO 1
22600	CC230	FORMAT(' DO YOU WANT TO PLOT THE IMAGE ?'/)
22700	CC	TYPE 230
22800	CC240	ACCEPT 83,ALFAB
22900	CC	IF(ALFAB.EQ.YES) GOTO 250
23000	CC	IF(ALFAB.EQ.NO ) GOTO 260
23100	CCCC	TYPE 103
23200	CC	GOTO 240
23300	CC250	CONTINUE
23400	252	CALL PLOU
23500		SHOW=.TRUE.
23600		LOAP=.FALSE.
23700		NOPR=.FALSE.
23800		PLAY=.TRUE.
23900		SAVP=.TRUE.
24000		NOLP=.FALSE.
24100		GOTO 260
24200	304	NOLU=.TRUE.
24300	305	IF(LOAU) GOTO 152
24400	300	FORMAT(' DO YOU WANT TO LOAD A PROCESSED IMAGE ?'/)
24500		GOTO 306
24600	307	NOPR=.TRUE.
24700	306	IF(PLAY) GOTO 235
24800	308	IF(NOLP) GOTO 260
24900		TYPE 300
25000	310	ACCEPT 83,ALFAB
25100		IF(ALFAB.EQ.YES) GOTO 320
25200		IF(ALFAB.EQ.NO ) GOTO 338
25300	CC	TYPE 103
25400		GOTO 308
25500	320	NAME=.TRUE.
25600	CC	TYPE 164
25700	CC	ACCEPT 133,DTA
25800	CC	TYPE 183,DTA
25900	CC	IF(ADMISS(DTA)) GOTO 330
26000	CC	TYPE 184
26100	CC	GOTO 320
26200	330	TYPE 204
26300		ACCEPT 83,FILE
26400	CC	TYPE 253,FILE
26500		DO 335 I=1,6000
26600	335	LIST(I,1)=0.
26700	CC	TAPE=8+DTA
26800	CC	CALL ZERPP
26850		REWIND TAPE
26900		CALL IFILE(TAPE,FILE)
27000		READ(TAPE) FILEN,RR,FLINE,LLINE,LSIDE,RSIDE,NEWEND,
27100		1 ((LIST(I,N),I=1,6),N=1,NEWEND)
27200		TYPE 202,NEWEND
27300		SHOW=.FALSE.
27400		LOAP=.TRUE.
27500		PLAY=.TRUE.
27600		NOLP=.FALSE.
27800		SAVP=.FALSE.
27900		GOTO 199
27950	338	IF(NOLP.AND.LOAU.AND.SAVU.AND.NOPR) GOTO 261
28000		NOLP=.TRUE.
28100	340	IF(.NOT.LOAP) GOTO 260
28200		IF(PLAY) GOTO 260
28300	339	FORMAT(' AN IMAGE WAS LOADED WITH THE PROGRAM'//)
28400		TYPE 339
28500		PLAY=.TRUE.
28600		LOAP=.TRUE.
28700		GOTO 210
28710	341	IF(NOLP) GOTO 261
28720		GOTO 308
28800	260	IF(SAVU.AND.NOPR.AND.(.NOT.LOAP).AND.LOAU) GOTO 341
28900		IF(LOAU) GOTO 75
29000	261	CALL TIMER(TIM2)
29100		TIM3=FLOAT(TIM2-TIM1)/60000.
29200	163	FORMAT(' THIS RUN CONSUMED ',F5.3,' MINUTES OF COMPUTING TIME'/)
29300		TYPE 163,TIM3
29400		END